home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / f2c_5_92 Folder / f2c_5_92 / f2c / sysdep.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-05-26  |  10.7 KB  |  445 lines  |  [TEXT/ttxt]
  1. /****************************************************************
  2. Copyright 1990, 1991 by AT&T Bell Laboratories and Bellcore.
  3.  
  4. Permission to use, copy, modify, and distribute this software
  5. and its documentation for any purpose and without fee is hereby
  6. granted, provided that the above copyright notice appear in all
  7. copies and that both that the copyright notice and this
  8. permission notice and warranty disclaimer appear in supporting
  9. documentation, and that the names of AT&T Bell Laboratories or
  10. Bellcore or any of their entities not be used in advertising or
  11. publicity pertaining to distribution of the software without
  12. specific, written prior permission.
  13.  
  14. AT&T and Bellcore disclaim all warranties with regard to this
  15. software, including all implied warranties of merchantability
  16. and fitness.  In no event shall AT&T or Bellcore be liable for
  17. any special, indirect or consequential damages or any damages
  18. whatsoever resulting from loss of use, data or profits, whether
  19. in an action of contract, negligence or other tortious action,
  20. arising out of or in connection with the use or performance of
  21. this software.
  22. ****************************************************************/
  23. #ifdef THINK_C
  24. #define MSDOS
  25. #endif
  26. #include "defs.h"
  27. #include "usignal.h"
  28.  
  29. char binread[] = "rb", textread[] = "r";
  30. char binwrite[] = "wb", textwrite[] = "w";
  31. char *c_functions    = "c_functions";
  32. char *coutput        = "c_output";
  33. char *initfname        = "raw_data";
  34. char *initbname        = "raw_data.b";
  35. char *blkdfname        = "block_data";
  36. char *p1_file        = "p1_file";
  37. char *p1_bakfile    = "p1_file.BAK";
  38. char *sortfname        = "init_file";
  39.  
  40. char link_msg[]        = "-lF77 -lI77 -lm -lc";
  41.  
  42. #ifndef TMPDIR
  43. #ifdef MSDOS
  44. #define TMPDIR ""
  45. #else
  46. #define TMPDIR "/tmp"
  47. #endif
  48. #endif
  49.  
  50. char *tmpdir = TMPDIR;
  51.  
  52.  void
  53. Un_link_all(cdelete)
  54. {
  55.     if (!debugflag) {
  56.         unlink(c_functions);
  57.         unlink(initfname);
  58.         unlink(p1_file);
  59.         unlink(sortfname);
  60.         unlink(blkdfname);
  61.         if (cdelete && coutput)
  62.             unlink(coutput);
  63.         }
  64.     }
  65.  
  66.  void
  67. set_tmp_names()
  68. {
  69.     int k;
  70.     if (debugflag == 1)
  71.         return;
  72.     k = strlen(tmpdir) + 16;
  73.     c_functions = (char *)ckalloc(7*k);
  74.     initfname = c_functions + k;
  75.     initbname = initfname + k;
  76.     blkdfname = initbname + k;
  77.     p1_file = blkdfname + k;
  78.     p1_bakfile = p1_file + k;
  79.     sortfname = p1_bakfile + k;
  80.     {
  81. #ifdef MSDOS
  82.     char buf[64], *s, *t;
  83.     if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
  84.         t = "";
  85.     else {
  86.         /* substitute \ for / to avoid confusion with a
  87.          * switch indicator in the system("sort ...")
  88.          * call in formatdata.c
  89.          */
  90.         for(s = tmpdir, t = buf; *s; s++, t++)
  91.             if ((*t = *s) == '/')
  92.                 *t = '\\';
  93.         if (t[-1] != '\\')
  94.             *t++ = '\\';
  95.         *t = 0;
  96.         t = buf;
  97.         }
  98.     sprintf(c_functions, "%sf2c_func", t);
  99.     sprintf(initfname, "%sf2c_rd", t);
  100.     sprintf(blkdfname, "%sf2c_blkd", t);
  101.     sprintf(p1_file, "%sf2c_p1f", t);
  102.     sprintf(p1_bakfile, "%sf2c_p1fb", t);
  103.     sprintf(sortfname, "%sf2c_sort", t);
  104. #else
  105.     int pid = getpid();
  106.     sprintf(c_functions, "%s/f2c%d_func", tmpdir, pid);
  107.     sprintf(initfname, "%s/f2c%d_rd", tmpdir, pid);
  108.     sprintf(blkdfname, "%s/f2c%d_blkd", tmpdir, pid);
  109.     sprintf(p1_file, "%s/f2c%d_p1f", tmpdir, pid);
  110.     sprintf(p1_bakfile, "%s/f2c%d_p1fb", tmpdir, pid);
  111.     sprintf(sortfname, "%s/f2c%d_sort", tmpdir, pid);
  112. #endif
  113.     sprintf(initbname, "%s.b", initfname);
  114.     }
  115.     if (debugflag)
  116.         fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
  117.             initfname, blkdfname, p1_file, p1_bakfile, sortfname);
  118.     }
  119.  
  120.  char *
  121. c_name(s,ft)char *s;
  122. {
  123.     char *b, *s0;
  124.     int c;
  125.  
  126.     b = s0 = s;
  127.     while(c = *s++)
  128.         if (c == '/')
  129.             b = s;
  130.     if (--s < s0 + 3 || s[-2] != '.'
  131.              || ((c = *--s) != 'f' && c != 'F')) {
  132.         infname = s0;
  133.         Fatal("file name must end in .f or .F");
  134.         }
  135.     *s = ft;
  136.     b = copys(b);
  137.     *s = c;
  138.     return b;
  139.     }
  140.  
  141.  static void
  142. killed(sig)
  143. {
  144.     signal(SIGINT, SIG_IGN);
  145. #ifdef SIGQUIT
  146.     signal(SIGQUIT, SIG_IGN);
  147. #endif
  148. #ifdef SIGHUP
  149.     signal(SIGHUP, SIG_IGN);
  150. #endif
  151.     signal(SIGTERM, SIG_IGN);
  152.     Un_link_all(1);
  153.     exit(126);
  154.     }
  155.  
  156.  static void
  157. sig1catch(sig)
  158. {
  159.     if (signal(sig, SIG_IGN) != SIG_IGN)
  160.         signal(sig, killed);
  161.     }
  162.  
  163.  static void
  164. flovflo(sig)
  165. {
  166.     Fatal("floating exception during constant evaluation; cannot recover");
  167.     /* vax returns a reserved operand that generates
  168.        an illegal operand fault on next instruction,
  169.        which if ignored causes an infinite loop.
  170.     */
  171.     signal(SIGFPE, flovflo);
  172. }
  173.  
  174.  void
  175. sigcatch(sig)
  176. {
  177.     sig1catch(SIGINT);
  178. #ifdef SIGQUIT
  179.     sig1catch(SIGQUIT);
  180. #endif
  181. #ifdef SIGHUP
  182.     sig1catch(SIGHUP);
  183. #endif
  184.     sig1catch(SIGTERM);
  185.     signal(SIGFPE, flovflo);  /* catch overflows */
  186.     }
  187.  
  188.  
  189. dofork()
  190. {
  191. #ifdef MSDOS
  192.     Fatal("Only one Fortran input file allowed under MS-DOS");
  193. #else
  194.     int pid, status, w;
  195.     extern int retcode;
  196.  
  197.     if (!(pid = fork()))
  198.         return 1;
  199.     if (pid == -1)
  200.         Fatal("bad fork");
  201.     while((w = wait(&status)) != pid)
  202.         if (w == -1)
  203.             Fatal("bad wait code");
  204.     retcode |= status >> 8;
  205. #endif
  206.     return 0;
  207.     }
  208.  
  209. /* Initialization of tables that change with the character set... */
  210.  
  211. char escapes[Table_size];
  212.  
  213. #ifdef non_ASCII
  214. char *str_fmt[Table_size];
  215. static char *str0fmt[127] = { /*}*/
  216. #else
  217. char *str_fmt[Table_size] = {
  218. #endif
  219.  "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
  220.    "\\b",   "\\t",   "\\n", "\\013",   "\\f",   "\\r", "\\016", "\\017",
  221.  "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
  222.  "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
  223.      " ",     "!",  "\\\"",     "#",     "$",     "%%",    "&",     "'",
  224.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  225.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  226.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  227.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  228.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  229.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  230.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  231.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  232.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  233.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  234.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  235.      };
  236.  
  237. #ifdef non_ASCII
  238. char *chr_fmt[Table_size];
  239. static char *chr0fmt[127] = {    /*}*/
  240. #else
  241. char *chr_fmt[Table_size] = {
  242. #endif
  243.    "\\0",   "\\1",   "\\2",   "\\3",   "\\4",   "\\5",   "\\6",   "\\7",
  244.    "\\b",   "\\t",   "\\n",  "\\13",   "\\f",   "\\r",  "\\16",  "\\17",
  245.   "\\20",  "\\21",  "\\22",  "\\23",  "\\24",  "\\25",  "\\26",  "\\27",
  246.   "\\30",  "\\31",  "\\32",  "\\33",  "\\34",  "\\35",  "\\36",  "\\37",
  247.      " ",     "!",    "\"",     "#",     "$",     "%%",    "&",   "\\'",
  248.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  249.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  250.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  251.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  252.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  253.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  254.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  255.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  256.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  257.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  258.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  259.      };
  260.  
  261.  void
  262. fmt_init()
  263. {
  264.     static char *str1fmt[6] =
  265.         { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
  266.     register int i, j;
  267.     register char *s;
  268.  
  269.     /* str_fmt */
  270.  
  271. #ifdef non_ASCII
  272.     i = 0;
  273. #else
  274.     i = 127;
  275. #endif
  276.     for(; i < Table_size; i++)
  277.         str_fmt[i] = "\\%03o";
  278. #ifdef non_ASCII
  279.     for(i = 32; i < 127; i++) {
  280.         s = str0fmt[i];
  281.         str_fmt[*(unsigned char *)s] = s;
  282.         }
  283.     str_fmt['"'] = "\\\"";
  284. #else
  285.     if (Ansi == 1)
  286.         str_fmt[7] = chr_fmt[7] = "\\a";
  287. #endif
  288.  
  289.     /* chr_fmt */
  290.  
  291. #ifdef non_ASCII
  292.     for(i = 0; i < 32; i++)
  293.         chr_fmt[i] = chr0fmt[i];
  294. #else
  295.     i = 127;
  296. #endif
  297.     for(; i < Table_size; i++)
  298.         chr_fmt[i] = "\\%o";
  299. #ifdef non_ASCII
  300.     for(i = 32; i < 127; i++) {
  301.         s = chr0fmt[i];
  302.         j = *(unsigned char *)s;
  303.         if (j == '\\')
  304.             j = *(unsigned char *)(s+1);
  305.         chr_fmt[j] = s;
  306.         }
  307. #endif
  308.  
  309.     /* escapes (used in lex.c) */
  310.  
  311.     for(i = 0; i < Table_size; i++)
  312.         escapes[i] = i;
  313.     for(s = "btnfr0", i = 0; i < 6; i++)
  314.         escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
  315.     /* finish str_fmt and chr_fmt */
  316.  
  317.     if (Ansi)
  318.         str1fmt[5] = "\\v";
  319.     if ('\v' == 'v') { /* ancient C compiler */
  320.         str1fmt[5] = "v";
  321. #ifndef non_ASCII
  322.         escapes['v'] = 11;
  323. #endif
  324.         }
  325.     else
  326.         escapes['v'] = '\v';
  327.     for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
  328.         str_fmt[j] = chr_fmt[j] = str1fmt[i++];
  329.     /* '\v' = 11 for both EBCDIC and ASCII... */
  330.     chr_fmt[11] = Ansi ? "\\v" : "\\13";
  331.     }
  332.  
  333.  
  334.  
  335. /* Unless SYSTEM_SORT is defined, the following gives a simple
  336.  * in-core version of dsort().  On Fortran source with huge DATA
  337.  * statements, the in-core version may exhaust the available memory,
  338.  * in which case you might either recompile this source file with
  339.  * SYSTEM_SORT defined (if that's reasonable on your system), or
  340.  * replace the dsort below with a more elaborate version that
  341.  * does a merging sort with the help of auxiliary files.
  342.  */
  343.  
  344. #ifdef SYSTEM_SORT
  345.  
  346. dsort(from, to)
  347.  char *from, *to;
  348. {
  349.     char buf[200];
  350.     sprintf(buf, "sort <%s >%s", from, to);
  351.     return system(buf) >> 8;
  352.     }
  353. #else
  354.  
  355.  static int
  356. compare(a,b)
  357.  char *a, *b;
  358. { return strcmp(*(char **)a, *(char **)b); }
  359.  
  360. dsort(from, to)
  361.  char *from, *to;
  362. {
  363.     extern char *Alloc();
  364.  
  365.     struct Memb {
  366.         struct Memb *next;
  367.         int n;
  368.         char buf[32000];
  369.         };
  370.     typedef struct Memb memb;
  371.     memb *mb, *mb1;
  372.     register char *x, *x0, *xe;
  373.     register int c, n;
  374.     FILE *f;
  375.     char **z, **z0;
  376.     int nn = 0;
  377.  
  378.     f = opf(from, textread);
  379.     mb = (memb *)Alloc(sizeof(memb));
  380.     mb->next = 0;
  381.     x0 = x = mb->buf;
  382.     xe = x + sizeof(mb->buf);
  383.     n = 0;
  384.     for(;;) {
  385.         c = getc(f);
  386.         if (x >= xe && (c != EOF || x != x0)) {
  387.             if (!n)
  388.                 return 126;
  389.             nn += n;
  390.             mb->n = n;
  391.             mb1 = (memb *)Alloc(sizeof(memb));
  392.             mb1->next = mb;
  393.             mb = mb1;
  394.             memcpy(mb->buf, x0, n = x-x0);
  395.             x0 = mb->buf;
  396.             x = x0 + n;
  397.             xe = x0 + sizeof(mb->buf);
  398.             n = 0;
  399.             }
  400.         if (c == EOF)
  401.             break;
  402.         if (c == '\n') {
  403.             ++n;
  404.             *x++ = 0;
  405.             x0 = x;
  406.             }
  407.         else
  408.             *x++ = c;
  409.         }
  410.     clf(&f, from, 1);
  411.     f = opf(to, textwrite);
  412.     if (x > x0) { /* shouldn't happen */
  413.         *x = 0;
  414.         ++n;
  415.         }
  416.     mb->n = n;
  417.     nn += n;
  418.     if (!nn) /* shouldn't happen */
  419.         goto done;
  420.     z = z0 = (char **)Alloc(nn*sizeof(char *));
  421.     for(mb1 = mb; mb1; mb1 = mb1->next) {
  422.         x = mb1->buf;
  423.         n = mb1->n;
  424.         for(;;) {
  425.             *z++ = x;
  426.             if (--n <= 0)
  427.                 break;
  428.             while(*x++);
  429.             }
  430.         }
  431.     qsort((char *)z0, nn, sizeof(char *), compare);
  432.     for(n = nn, z = z0; n > 0; n--)
  433.         fprintf(f, "%s\n", *z++);
  434.     free((char *)z0);
  435.  done:
  436.     clf(&f, to, 1);
  437.     do {
  438.         mb1 = mb->next;
  439.         free((char *)mb);
  440.         }
  441.         while(mb = mb1);
  442.     return 0;
  443.     }
  444. #endif
  445.